home *** CD-ROM | disk | FTP | other *** search
/ Cream of the Crop 26 / Cream of the Crop 26.iso / program / ddj0897.zip / DYN401.ZIP / class / array.c next >
C/C++ Source or Header  |  1997-04-16  |  23KB  |  832 lines
  1.  
  2.  
  3. /*  Copyright (c) 1993-1996 Algorithms Corporation  */
  4. /*  All rights reserved.  */
  5.  
  6.  
  7.  
  8.  
  9. /*  This file automatically generated by dpp - do not edit  */
  10.  
  11. #define    DPP_STRATEGY    2
  12. #define    DPP_FASTWIDE    0
  13.  
  14.  
  15.  
  16. #line 19 "array.d"
  17. #include <string.h> 
  18. #include "memalloc.h" 
  19.  
  20.  
  21. #include "array1.h" 
  22. #include "array2.h" 
  23.  
  24. #define    CLASS    Array_c
  25. #define    ivType    Array_iv_t
  26.  
  27. #include "generics.h"
  28.  
  29. object    Array_c;
  30.  
  31.  
  32. #line 33 "array.c"
  33. typedef struct  _Array_iv_t  {
  34.     char iType;
  35.     unsigned iRank;
  36.     INDEX_TYPE * iShape;
  37.     INDEX_TYPE iNelm;
  38.     void * iArray;
  39.     void * iRmp;
  40. }    Array_iv_t;
  41.  
  42.  
  43. #line 38 "array.d"
  44. static int Index_origin = 0; 
  45.  
  46. static int _A_esize(int type); 
  47. static void print_val(object str,ivType *iv,char *fmt1,char *fmt2); 
  48. static void p_val_mat(object str,unsigned rank,unsigned *shape,char **val ,int size,char *fmt,unsigned *bit_indx,char *buf, int typ); 
  49. static objrtn print_nest(object s, ivType *iv); 
  50. static objrtn Dup(object self,int ntype,int dval,int deep); 
  51. static int convert(ivType *iv,ivType *iv2); 
  52.  
  53.  
  54.  
  55. static unsigned char pow1[] = { 1, 2, 4, 8, 16, 32, 64, 128 }; 
  56. static unsigned char pow2[] = { ~1, ~2, ~4, ~8, ~16, ~32, ~64, 
  57.         (unsigned char)~128 }; 
  58.  
  59. static char OOB[] = "Error: Out of bounds array index.\n"; 
  60.  
  61.  
  62. cmeth objrtn Array_cm_gNew(object self)
  63. { 
  64.     return gShouldNotImplement(self, "gNew"); 
  65. } 
  66.  
  67. cmeth objrtn Array_cm_gNewArray(object self, int type, int rank, va_list _rest_)
  68. { 
  69.     int i; 
  70.     INDEX_TYPE n; 
  71.     object array = oSuper(Array_c, gNew, self)(self); 
  72.     ivType *iv = ivPtr(array); 
  73.  
  74.     iv->iType = type; 
  75.     iv->iRank = rank; 
  76.     iv->iShape = rank ? MTnalloc(INDEX_TYPE, rank, iv->iShape) : (INDEX_TYPE *) NULL; 
  77.     for (i=0, n=1 ; i < rank ; ++i) 
  78.         n *= iv->iShape[i] = GetArg(unsigned); 
  79.     iv->iNelm = n; 
  80.     if (type == AT_OBJ) { 
  81.         iv->iArray = n ? Tncalloc(char, (unsigned) SIZE(type, n)) : NULL; 
  82.         iv->iRmp = gRegisterMemory(Dynace, iv->iArray, (long) SIZE(type, n)); 
  83.     } else 
  84.         iv->iArray = n ? MTncalloc(char, (unsigned) SIZE(type, n), iv->iArray) : NULL; 
  85.     return array; 
  86. } 
  87.  
  88.  
  89.  
  90. static objrtn NewArray(object self, int type, int rank, unsigned *idx)
  91. { 
  92.     int i; 
  93.     INDEX_TYPE n; 
  94.     object array = oSuper(Array_c, gNew, self)(self); 
  95.     ivType *iv = ivPtr(array); 
  96.  
  97.     iv->iType = type; 
  98.     iv->iRank = rank; 
  99.     iv->iShape = rank ? MTnalloc(INDEX_TYPE, rank, iv->iShape) : (INDEX_TYPE *) NULL; 
  100.     for (i=0, n=1 ; i < rank ; ++i) 
  101.         n *= iv->iShape[i] = idx[i]; 
  102.     iv->iNelm = n; 
  103.     if (type == AT_OBJ) { 
  104.         iv->iArray = n ? Tncalloc(char, (unsigned) SIZE(type, n)) : NULL; 
  105.         iv->iRmp = gRegisterMemory(Dynace, iv->iArray, (long) SIZE(type, n)); 
  106.     } else 
  107.         iv->iArray = n ? MTncalloc(char, (unsigned) SIZE(type, n), iv->iArray) : NULL; 
  108.     return array; 
  109. } 
  110.  
  111. imeth objrtn Array_im_gDispose(object self)
  112. { Array_iv_t *iv = GetIVs(Array, self);
  113.     if (iv->iShape) 
  114.         MA_free(iv->iShape); 
  115.     if (iv->iArray) 
  116.         if (iv->iType == AT_OBJ) 
  117.         free(iv->iArray); 
  118.     else 
  119.         MA_free(iv->iArray); 
  120.     if (iv->iRmp) 
  121.         gRemoveRegisteredMemory(Dynace, iv->iRmp); 
  122.     oSuper(Array_c, gDispose, self)(self); 
  123.     return NULL; 
  124. } 
  125.  
  126. imeth objrtn Array_im_gDeepDispose(object self)
  127. { Array_iv_t *iv = GetIVs(Array, self);
  128.     object *v; 
  129.     INDEX_TYPE i; 
  130.  
  131.     if (iv->iType == AT_OBJ) { 
  132.         v = (object *) iv->iArray; 
  133.         for (i=0 ; i != iv->iNelm ; ++i) 
  134.             if (v[i]) { 
  135.             gDeepDispose(v[i]); 
  136.             v[i] = NULL; 
  137.         } 
  138.     } 
  139.  
  140.     if (iv->iShape) 
  141.         MA_free(iv->iShape); 
  142.     if (iv->iArray) 
  143.         if (iv->iType == AT_OBJ) 
  144.         free(iv->iArray); 
  145.     else 
  146.         MA_free(iv->iArray); 
  147.     if (iv->iRmp) 
  148.         gRemoveRegisteredMemory(Dynace, iv->iRmp); 
  149.     oSuper(Array_c, gDispose, self)(self); 
  150.     return NULL; 
  151. } 
  152.  
  153. imeth void * Array_im_gArrayPointer(object self)
  154. { Array_iv_t *iv = GetIVs(Array, self);
  155.     return iv->iArray; 
  156. } 
  157.  
  158. imeth unsigned Array_im_gRank(object self)
  159. { Array_iv_t *iv = GetIVs(Array, self);
  160.     return iv->iRank; 
  161. } 
  162.  
  163. imeth objrtn Array_im_gShape(object self)
  164. { Array_iv_t *iv = GetIVs(Array, self);
  165.     unsigned i; 
  166.     object r; 
  167.     ivType *iv2; 
  168.  
  169.     r = vNew(ShortArray, 1, iv->iRank); 
  170.     iv2 = ivPtr(r); 
  171.  
  172.     for (i=0 ; i < iv->iRank ; ++i) 
  173.         ((INDEX_TYPE *) iv2->iArray)[i] = iv->iShape[i]; 
  174.  
  175.     return r; 
  176. } 
  177.  
  178. imeth void * Array_im_gIndex(object self, va_list _rest_)
  179. { Array_iv_t *iv = GetIVs(Array, self);
  180.     INDEX_TYPE offset, r, i; 
  181.  
  182.     if (iv->iType == AT_BIT) 
  183.         gError(self, "Cannot use gIndex on BitArray\n"); 
  184.     if (!iv->iRank) 
  185.         return iv->iArray; 
  186.     r = iv->iRank - 1; 
  187.     for (i=0, offset=(INDEX_TYPE) 0 ; i <= r ; ++i) { 
  188.         INDEX_TYPE m, n, j; 
  189.  
  190.         n = GetArg(unsigned) - Index_origin; 
  191.         if (n >= iv->iShape[i]) 
  192.             gError(self, OOB); 
  193.         for (m=1, j=r ; j != i ; ) 
  194.             m *= iv->iShape[j--]; 
  195.         if (!m) 
  196.             gError(self, OOB); 
  197.         offset += m * n; 
  198.     } 
  199.     return (void *) ((char *) iv->iArray + _A_esize(iv->iType) * offset); 
  200. } 
  201.  
  202. ivmeth int Array_ivm_vBitValue(object self, va_list _rest_)
  203. { Array_iv_t *iv = GetIVs(Array, self);
  204.     int i, r; 
  205.     INDEX_TYPE offset; 
  206.     MAKE_REST(self); 
  207.  
  208.     if (iv->iType != AT_BIT) 
  209.         gError(self, "Error: Can't use vBitValue on non-BitArrays\n"); 
  210.     r = iv->iRank - 1; 
  211.     for (i=0, offset=(INDEX_TYPE) 0 ; i <= r ; ++i) { 
  212.         INDEX_TYPE m; 
  213.         INDEX_TYPE n; 
  214.         register int j; 
  215.  
  216.         n = GetArg(INDEX_TYPE) - Index_origin; 
  217.         if (n >= iv->iShape[i]) 
  218.             gError(self, OOB); 
  219.         for (m=1, j=r ; j != i ; ) 
  220.             m *= iv->iShape[j--]; 
  221.         if (!m) 
  222.             gError(self, OOB); 
  223.         offset += m * n; 
  224.     } 
  225.     return !!BIT_VAL(iv->iArray, offset); 
  226. } 
  227.  
  228. #line 229 "array.c"
  229.  
  230. static    int    Array_ifm_vBitValue(object self, ...)
  231. {
  232.     va_list    _rest_;
  233.     va_start(_rest_, self);
  234.     return Array_ivm_vBitValue(self, _rest_);
  235. }
  236.  
  237.  
  238.  
  239. #line 222 "array.d"
  240. ivmeth objrtn Array_ivm_vChangeBitValue(object self, va_list _rest_)
  241. { Array_iv_t *iv = GetIVs(Array, self);int v = va_arg(_rest_, int);
  242.     int i, r; 
  243.     INDEX_TYPE offset; 
  244.     MAKE_REST(v); 
  245.  
  246.     if (iv->iType != AT_BIT) 
  247.         gError(self, "Error: Can't use vChangeBitValue on non-BitArrays\n"); 
  248.     r = iv->iRank - 1; 
  249.     for (i=0, offset=(INDEX_TYPE) 0 ; i <= r ; ++i) { 
  250.         INDEX_TYPE m; 
  251.         INDEX_TYPE n; 
  252.         register int j; 
  253.  
  254.         n = GetArg(INDEX_TYPE) - Index_origin; 
  255.         if (n >= iv->iShape[i]) 
  256.             gError(self, OOB); 
  257.         for (m=1, j=r ; j != i ; ) 
  258.             m *= iv->iShape[j--]; 
  259.         if (!m) 
  260.             gError(self, OOB); 
  261.         offset += m * n; 
  262.     } 
  263.     SET_BIT(iv->iArray, offset, v); 
  264.     return self; 
  265. } 
  266.  
  267. #line 268 "array.c"
  268.  
  269. static    objrtn    Array_ifm_vChangeBitValue(object self, ...)
  270. {
  271.     va_list    _rest_;
  272.     va_start(_rest_, self);
  273.     return Array_ivm_vChangeBitValue(self, _rest_);
  274. }
  275.  
  276.  
  277.  
  278. #line 249 "array.d"
  279. cmeth objrtn Array_cm_gIota(object self, int n)
  280. { 
  281.     INDEX_TYPE c; 
  282.     int i; 
  283.     object a; 
  284.     ivType *iv; 
  285.  
  286.     USE(self); 
  287.     a = vNew(ShortArray, 1, n); 
  288.     iv = ivPtr(a); 
  289.     for (c=Index_origin, i=0 ; i < n ; ) 
  290.         ((short *) iv->iArray)[i++] = c++; 
  291.     return a; 
  292. } 
  293.  
  294. ivmeth objrtn Array_ivm_vReshape(object self, va_list _rest_)
  295. { Array_iv_t *iv = GetIVs(Array, self);unsigned rank = va_arg(_rest_, unsigned);
  296.     INDEX_TYPE n, *shape, d, i; 
  297.     MAKE_REST(rank); 
  298.  
  299.     shape = rank ? MTnalloc(INDEX_TYPE, rank, iv->iShape) : (INDEX_TYPE *) NULL; 
  300.     for (i=0, n=1 ; i < rank ; ++i) { 
  301.         d = GetArg(INDEX_TYPE); 
  302.         n *= d; 
  303.         shape[i] = d; 
  304.     } 
  305.  
  306.     if (iv->iNelm != n) { 
  307.         char *fp, *tp; 
  308.         void *array; 
  309.         INDEX_TYPE s1, s2, s1org; 
  310.  
  311.         s1org = s1 = SIZE(iv->iType, iv->iNelm); 
  312.         s2 = SIZE(iv->iType, n); 
  313.         if (iv->iType == AT_OBJ) 
  314.             array = n ? Tncalloc(char, s2) : NULL; 
  315.         else 
  316.             array = n ? MTncalloc(char, s2, iv->iArray) : NULL; 
  317.  
  318.         fp = (char *) iv->iArray; 
  319.         tp = (char *) array; 
  320.         while (s2) { 
  321.             unsigned m; 
  322.  
  323.             m = s2 < s1 ? s2 : s1; 
  324.             memcpy(tp, fp, m); 
  325.             s2 -= m; 
  326.             s1 -= m; 
  327.             if (!s1) { 
  328.                 fp = (char *) iv->iArray; 
  329.                 s1 = s1org; 
  330.             } else 
  331.                 fp += m; 
  332.             tp += m; 
  333.         } 
  334.         if (iv->iArray) 
  335.             if (iv->iType == AT_OBJ) 
  336.             free(iv->iArray); 
  337.         else 
  338.             MA_free(iv->iArray); 
  339.         iv->iArray = array; 
  340.  
  341.         iv->iNelm = n; 
  342.         if (iv->iType == AT_OBJ) { 
  343.             void *rmp = gRegisterMemory(Dynace, iv->iArray, (long) SIZE(iv->iType, iv->iNelm)); 
  344.             gRemoveRegisteredMemory(Dynace, iv->iRmp); 
  345.             iv->iRmp = rmp; 
  346.         } 
  347.     } 
  348.     iv->iRank = rank; 
  349.     if (iv->iShape) 
  350.         MA_free(iv->iShape); 
  351.     iv->iShape = shape; 
  352.  
  353.     return self; 
  354. } 
  355.  
  356. #line 357 "array.c"
  357.  
  358. static    objrtn    Array_ifm_vReshape(object self, ...)
  359. {
  360.     va_list    _rest_;
  361.     va_start(_rest_, self);
  362.     return Array_ivm_vReshape(self, _rest_);
  363. }
  364.  
  365.  
  366. #line 328 "array.d"
  367. static int _A_esize(int type) 
  368. { 
  369.     switch (type) { 
  370.         case AT_CHAR: return sizeof(char); 
  371.         case AT_SHRT: return sizeof(short); 
  372.         case AT_USHT: return sizeof(_ushort); 
  373.         case AT_INT: return sizeof(int); 
  374.         case AT_LONG: return sizeof(long); 
  375.         case AT_FLOT: return sizeof(float); 
  376.         case AT_DBLE: return sizeof(double); 
  377.         case AT_OBJ: return sizeof(object); 
  378.         case AT_BIT: return 0; 
  379.         case AT_PNTR: return sizeof(char *); 
  380.         default: return 0; 
  381.     } 
  382. } 
  383.  
  384. imeth int Array_im_gSize(object self)
  385. { Array_iv_t *iv = GetIVs(Array, self);
  386.     return iv->iNelm; 
  387. } 
  388.  
  389. imeth int Array_im_gEqual(object self, object obj)
  390. { Array_iv_t *iv = GetIVs(Array, self);
  391.     ivType *iv2; 
  392.     unsigned i; 
  393.  
  394.     ChkArg(obj, 2); 
  395.     if (!gIsKindOf(obj, CLASS)) 
  396.         return 0; 
  397.     iv2 = ivPtr(obj); 
  398.     if (iv->iType != iv2->iType || iv->iRank != iv2->iRank || iv->iNelm != iv2->iNelm) 
  399.         return 0; 
  400.     for (i=0 ; i < iv->iRank ; ++i) 
  401.         if (iv->iShape[i] != iv2->iShape[i]) 
  402.         return 0; 
  403.     return iv->iArray ? !memcmp(iv->iArray, iv2->iArray, (int) SIZE(iv->iType, iv->iNelm)) : 1; 
  404. } 
  405.  
  406. imeth objrtn Array_im_gStringRepValue(object self)
  407. { Array_iv_t *iv = GetIVs(Array, self);
  408.     object s; 
  409.  
  410.     s = gNew(String); 
  411.     switch (iv->iType) { 
  412.         case AT_CHAR: print_val(s, iv, "%c", "%c"); break; 
  413.         case AT_SHRT: print_val(s, iv, "%hd ", "%6hd "); break; 
  414.         case AT_USHT: print_val(s, iv, "%hu ", "%5hu "); break; 
  415.         case AT_INT: print_val(s, iv, "%d ", "%6d "); break; 
  416.         case AT_LONG: print_val(s, iv, "%ld ", "%10ld "); break; 
  417.         case AT_FLOT: print_val(s, iv, "%hf ", "%10.2hf "); break; 
  418.         case AT_DBLE: print_val(s, iv, "%lf ", "%10.2lf "); break; 
  419.         case AT_OBJ: print_nest(s, iv); break; 
  420.         case AT_BIT: print_val(s, iv, "%d ", "%1d "); break; 
  421.         case AT_PNTR: print_val(s, iv, "%lx ", "%8lx "); break; 
  422.     } 
  423.     return s; 
  424. } 
  425.  
  426. imeth objrtn Array_im_gStringRep(object self)
  427. { Array_iv_t *iv = GetIVs(Array, self);
  428.     char *t, buf[60]; 
  429.     object s; 
  430.  
  431.     switch (iv->iType) { 
  432.         case AT_CHAR: t = "Character"; break; 
  433.         case AT_SHRT: t = "Short"; break; 
  434.         case AT_USHT: t = "Unsigned Short"; break; 
  435.         case AT_INT: t = "Integer"; break; 
  436.         case AT_LONG: t = "Long"; break; 
  437.         case AT_FLOT: t = "Float"; break; 
  438.         case AT_DBLE: t = "Double"; break; 
  439.         case AT_OBJ: t = "Object Array"; break; 
  440.         case AT_BIT: t = "Bit"; break; 
  441.         case AT_PNTR: t = "Pointer"; break; 
  442.         default: t = "Unknown"; break; 
  443.     } 
  444.     s = vSprintf(String, "Type  = %s\n", t); 
  445.     sprintf(buf, "Rank  = %d\n", (int) iv->iRank); 
  446.     gAppend(s, (object) buf); 
  447.  
  448.     if (iv->iRank) { 
  449.         unsigned i; 
  450.  
  451.         gAppend(s, (object) "Shape = "); 
  452.         for (i=0 ; i < iv->iRank ; ) { 
  453.             sprintf(buf, PRNT_SHAPE, iv->iShape[i++]); 
  454.             gAppend(s, (object) buf); 
  455.         } 
  456.         gAppend(s, (object) "\n"); 
  457.     } 
  458.     gAppend(s, (object) "Value = "); 
  459.     switch (iv->iType) { 
  460.         case AT_CHAR: print_val(s, iv, "%c", "%c"); break; 
  461.         case AT_SHRT: print_val(s, iv, "%hd ", "%6hd "); break; 
  462.         case AT_USHT: print_val(s, iv, "%hu ", "%5hu "); break; 
  463.         case AT_INT: print_val(s, iv, "%d ", "%6d "); break; 
  464.         case AT_LONG: print_val(s, iv, "%ld ", "%10ld "); break; 
  465.         case AT_FLOT: print_val(s, iv, "%hf ", "%10.2hf "); break; 
  466.         case AT_DBLE: print_val(s, iv, "%lf ", "%10.2lf "); break; 
  467.         case AT_OBJ: print_nest(s, iv); break; 
  468.         case AT_BIT: print_val(s, iv, "%d ", "%1d "); break; 
  469.         case AT_PNTR: print_val(s, iv, "%lx ", "%8lx "); break; 
  470.     } 
  471.     return s; 
  472. } 
  473.  
  474. static void _fmt(char *buf, char *fmt, void *var, int typ) 
  475. { 
  476.     switch (typ) { 
  477.         case AT_CHAR: sprintf(buf, fmt, *((char *) var)); break; 
  478.         case AT_SHRT: sprintf(buf, fmt, *((short *) var)); break; 
  479.         case AT_USHT: sprintf(buf, fmt, *((_ushort *) var)); break; 
  480.         case AT_INT: sprintf(buf, fmt, *((int *) var)); break; 
  481.         case AT_LONG: sprintf(buf, fmt, *((long *) var)); break; 
  482.         case AT_FLOT: sprintf(buf, fmt, *((float *) var)); break; 
  483.         case AT_DBLE: sprintf(buf, fmt, *((double *) var)); break; 
  484.         case AT_OBJ: sprintf(buf, fmt, *((object *) var)); break; 
  485.         case AT_PNTR: sprintf(buf, fmt, *((void **) var)); break; 
  486.     } 
  487. } 
  488.  
  489. static void print_val(object str, ivType *iv, char *fmt1, char *fmt2) 
  490. { 
  491.     INDEX_TYPE i, bit_indx = 0; 
  492.     int s = _A_esize(iv->iType); 
  493.     char buf[60], *val; 
  494.  
  495.     switch (iv->iRank) { 
  496.         case 0: if (iv->iType != AT_BIT) { 
  497.             _fmt(buf, fmt1, iv->iArray, iv->iType); 
  498.             if (iv->iType == AT_CHAR) 
  499.                 vBuild(str, NULL, "\"", buf, "\"\n", NULL); 
  500.             else 
  501.                 vBuild(str, NULL, buf, "\n", NULL); 
  502.         } else { 
  503.             sprintf(buf, fmt1, !!BIT_VAL(iv->iArray, 0)); 
  504.             vBuild(str, NULL, buf, "\n", NULL); 
  505.         } 
  506.         break; 
  507.         case 1: if (iv->iType != AT_BIT) { 
  508.             if (iv->iType == AT_CHAR) 
  509.                 gAppend(str, (object) "\""); 
  510.             val = (char *) iv->iArray; 
  511.             for (i=0 ; i++ != *iv->iShape ; val+=s) { 
  512.                 _fmt(buf, fmt1, val, iv->iType); 
  513.                 gAppend(str, (object) buf); 
  514.             } 
  515.             if (iv->iType == AT_CHAR) 
  516.                 gAppend(str, (object) "\""); 
  517.         } else 
  518.             for (i=0 ; i != *iv->iShape ; ++i) { 
  519.             sprintf(buf, fmt1, !!BIT_VAL(val, i)); 
  520.             gAppend(str, (object) buf); 
  521.         } 
  522.         gAppend(str, (object) "\n"); 
  523.         break; 
  524.         default:gAppend(str, (object) "\n\n"); 
  525.         val = (char *) iv->iArray; 
  526.         p_val_mat(str, iv->iRank, iv->iShape, &val, s, fmt2, &bit_indx, buf, iv->iType); 
  527.     } 
  528. } 
  529.  
  530. static void p_val_mat(object str, unsigned rank, INDEX_TYPE *shape, char **val, int size, char *fmt, INDEX_TYPE *bit_indx, char *buf, int type) 
  531. { 
  532.     INDEX_TYPE r, c; 
  533.  
  534.     if (rank == 2) 
  535.         if (size) 
  536.         for (r=0 ; r++ != *shape ; ) { 
  537.         for (c=0 ; c++ != shape[1] ; (*val)+=size) { 
  538.             _fmt(buf, fmt, *val, type); 
  539.             gAppend(str, (object) buf); 
  540.         } 
  541.         gAppend(str, (object) "\n"); 
  542.     } 
  543.     else 
  544.         for (r=0 ; r++ != *shape ; ) { 
  545.         for (c=0 ; c++ != shape[1] ; (*bit_indx)++) { 
  546.             sprintf(buf, fmt, !!BIT_VAL(*val, *bit_indx)); 
  547.             gAppend(str, (object) buf); 
  548.         } 
  549.         gAppend(str, (object) "\n"); 
  550.     } 
  551.     else 
  552.         for (r=0 ; r++ != *shape ; ) { 
  553.         p_val_mat(str, rank-1, shape+1, val, size, fmt, bit_indx, buf, type); 
  554.         gAppend(str, (object) "\n"); 
  555.     } 
  556. } 
  557.  
  558. static objrtn print_nest(object s, ivType *iv) 
  559. { 
  560.     INDEX_TYPE i; 
  561.     object *val = (object *) iv->iArray; 
  562.     object t; 
  563.  
  564.     for (i=0 ; i++ != iv->iNelm ; ) { 
  565.         if (t = *val++) { 
  566.             t = gStringRepValue(*val++); 
  567.             vBuild(s, NULL, "\n", t, "\n", NULL); 
  568.             gDispose(t); 
  569.         } else 
  570.             gAppend(s, (object) "NULL\n"); 
  571.     } 
  572.     return s; 
  573. } 
  574.  
  575.  
  576.  
  577. static objrtn Dup(object self, int ntype, int dval, int deep)
  578.  
  579.  
  580.  
  581. { Array_iv_t *iv = GetIVs(Array, self);
  582.     register unsigned i; 
  583.     object narray, cls; 
  584.     ivType *iv2; 
  585.  
  586.     if (!ntype) 
  587.         ntype = iv->iType; 
  588.     if (ntype != iv->iType && ( 
  589.         ntype == AT_OBJ || ntype == AT_PNTR || 
  590.         iv->iType == AT_OBJ || iv->iType == AT_PNTR)) 
  591.         gError(self, "Error:  Can't convert array to requested type.\n"); 
  592.  
  593.     switch (ntype) { 
  594.         case AT_CHAR: cls = CharacterArray; break; 
  595.         case AT_SHRT: cls = ShortArray; break; 
  596.         case AT_USHT: cls = UnsignedShortArray; break; 
  597.         case AT_INT: cls = IntegerArray; break; 
  598.         case AT_LONG: cls = LongArray; break; 
  599.         case AT_FLOT: cls = FloatArray; break; 
  600.         case AT_DBLE: cls = DoubleFloatArray; break; 
  601.         case AT_BIT: cls = BitArray; break; 
  602.         case AT_OBJ: cls = ObjectArray; break; 
  603.         case AT_PNTR: cls = PointerArray; break; 
  604.         default: cls = NULL; break; 
  605.     } 
  606.     narray = NewArray(cls, ntype, iv->iRank, iv->iShape); 
  607.     iv2 = ivPtr(narray); 
  608.  
  609.     if (dval) 
  610.         if (ntype == iv->iType) 
  611.         if (iv->iType == AT_OBJ && deep) { 
  612.         object *fv = (object *) iv->iArray; 
  613.         object *tv = (object *) iv2->iArray; 
  614.         for (i=0 ; i != iv->iNelm ; ++i) 
  615.             if (fv[i]) 
  616.             tv[i] = gDeepCopy(fv[i]); 
  617.     } else 
  618.         memcpy(iv2->iArray, iv->iArray, (int) SIZE(iv->iType, iv->iNelm)); 
  619.     else 
  620.         convert(iv, iv2); 
  621.     return narray; 
  622. } 
  623.  
  624. #define Ftod(x) (double)(x) 
  625. #define Dtol(x) (long)(x) 
  626.  
  627. #if 0 
  628. #define CONV(tt, ft) while (n--) *((tt *) nval)++ = (tt) *((ft *) val)++ 
  629. #define CONVFI(tt, ft) while (n--) *((tt *) nval)++ = (tt) Dtol((double)*((ft *) val)++) 
  630. #define CONVFD() while (n--) *((double *) nval)++ = Ftod(*((float *) val)++) 
  631. #define CONVFB(tt) while (n--) *((tt *) nval)++ = (tt) !!BIT_VAL(val, n) 
  632. #define CONVTB(ft) for (m=0 ; m != n ; m++) SET_BIT(nval, m, *((ft *) val)++) 
  633. #else 
  634.  
  635. #line 600 "array.d"
  636. #define CONV(tt, ft) while (n--) { *((tt *) nval) = (tt) *((ft *) val); nval = (void *) (1 + (tt *) nval); val = (void *) (1 + (ft *) val); } 
  637.  
  638. #line 606 "array.d"
  639. #define CONVFI(tt, ft) while (n--) { *((tt *) nval) = (tt) Dtol((double)*(ft *) val); nval = (void *) (1 + (tt *) nval); val = (void *) (1 + (ft *) val); } 
  640.  
  641. #line 612 "array.d"
  642. #define CONVFD() while (n--) { *((double *) nval) = Ftod(*((float *) val)); nval = (void *) (1 + (double *) nval); val = (void *) (1 + (float *) val); } 
  643.  
  644.  
  645.  
  646.  
  647. #define CONVFB(tt) while (n--) { *((tt *) nval) = (tt) !!BIT_VAL(val, n); nval = (void *) (1 + (tt *) nval); } 
  648.  
  649.  
  650.  
  651.  
  652. #define CONVTB(ft) for (m=0 ; m != n ; m++) { SET_BIT(nval, m, *((ft *) val)); val = (void *) (1 + (ft *) val); } 
  653. #endif 
  654.  
  655. static int convert(ivType *iv, ivType *iv2) 
  656. { 
  657.     INDEX_TYPE m; 
  658.     INDEX_TYPE n = iv->iNelm; 
  659.     void *val = iv->iArray; 
  660.     void *nval = iv2->iArray; 
  661.  
  662.     switch (iv2->iType) { 
  663.         case AT_CHAR: 
  664.         switch (iv->iType) { 
  665.             case AT_SHRT: CONV(char, short); break; 
  666.             case AT_USHT: CONV(char, _ushort); break; 
  667.             case AT_INT: CONV(char, int); break; 
  668.             case AT_LONG: CONV(char, long); break; 
  669.             case AT_FLOT: CONVFI(char, float); break; 
  670.             case AT_DBLE: CONVFI(char, double); break; 
  671.             case AT_BIT: CONVFB(char); break; 
  672.             default: return(1); break; 
  673.         } 
  674.         break; 
  675.         case AT_SHRT: 
  676.         switch (iv->iType) { 
  677.             case AT_CHAR: CONV(short, char); break; 
  678.             case AT_USHT: CONV(short, _ushort); break; 
  679.             case AT_INT: CONV(short, int); break; 
  680.             case AT_LONG: CONV(short, long); break; 
  681.             case AT_FLOT: CONVFI(short, float); break; 
  682.             case AT_DBLE: CONVFI(short, double); break; 
  683.             case AT_BIT: CONVFB(short); break; 
  684.             default: return(1); break; 
  685.         } 
  686.         break; 
  687.         case AT_USHT: 
  688.         switch (iv->iType) { 
  689.             case AT_CHAR: CONV(_ushort, char); break; 
  690.             case AT_SHRT: CONV(_ushort, short); break; 
  691.             case AT_INT: CONV(_ushort, int); break; 
  692.             case AT_LONG: CONV(_ushort, long); break; 
  693.             case AT_FLOT: CONVFI(_ushort, float); break; 
  694.             case AT_DBLE: CONVFI(_ushort, double); break; 
  695.             case AT_BIT: CONVFB(_ushort); break; 
  696.             default: return(1); break; 
  697.         } 
  698.         break; 
  699.         case AT_INT: 
  700.         switch (iv->iType) { 
  701.             case AT_CHAR: CONV(int, char); break; 
  702.             case AT_SHRT: CONV(int, short); break; 
  703.             case AT_USHT: CONV(int, _ushort); break; 
  704.             case AT_LONG: CONV(int, long); break; 
  705.             case AT_FLOT: CONVFI(int, float); break; 
  706.             case AT_DBLE: CONVFI(int, double); break; 
  707.             case AT_BIT: CONVFB(int); break; 
  708.             default: return(1); break; 
  709.         } 
  710.         break; 
  711.         case AT_LONG: 
  712.         switch (iv->iType) { 
  713.             case AT_CHAR: CONV(long, char); break; 
  714.             case AT_SHRT: CONV(long, short); break; 
  715.             case AT_USHT: CONV(long, _ushort); break; 
  716.             case AT_INT: CONV(long, int); break; 
  717.             case AT_FLOT: CONVFI(long, float); break; 
  718.             case AT_DBLE: CONVFI(long, double); break; 
  719.             case AT_BIT: CONVFB(long); break; 
  720.             default: return(1); break; 
  721.         } 
  722.         break; 
  723.         case AT_FLOT: 
  724.         switch (iv->iType) { 
  725.             case AT_CHAR: CONV(float, char); break; 
  726.             case AT_SHRT: CONV(float, short); break; 
  727.             case AT_USHT: CONV(float, _ushort); break; 
  728.             case AT_INT: CONV(float, int); break; 
  729.             case AT_LONG: CONV(float, long); break; 
  730.             case AT_DBLE: CONV(float, double); break; 
  731.             case AT_BIT: CONVFB(float); break; 
  732.             default: return(1); break; 
  733.         } 
  734.         break; 
  735.         case AT_DBLE: 
  736.         switch (iv->iType) { 
  737.             case AT_CHAR: CONV(double, char); break; 
  738.             case AT_SHRT: CONV(double, short); break; 
  739.             case AT_USHT: CONV(double, _ushort); break; 
  740.             case AT_INT: CONV(double, int); break; 
  741.             case AT_LONG: CONV(double, long); break; 
  742.             case AT_FLOT: CONVFD(); break; 
  743.             case AT_BIT: CONVFB(double); break; 
  744.             default: return(1); break; 
  745.         } 
  746.         break; 
  747.         case AT_BIT: 
  748.         switch (iv->iType) { 
  749.             case AT_CHAR: CONVTB(char); break; 
  750.             case AT_SHRT: CONVTB(short); break; 
  751.             case AT_USHT: CONVTB(_ushort); break; 
  752.             case AT_INT: CONVTB(int); break; 
  753.             case AT_LONG: CONVTB(long); break; 
  754.             case AT_FLOT: CONVTB(float); break; 
  755.             case AT_DBLE: CONVTB(double); break; 
  756.             default: return(1); break; 
  757.         } 
  758.         break; 
  759.         default: return(1); break; 
  760.     } 
  761.     return(0); 
  762. } 
  763.  
  764. imeth objrtn Array_im_gCopy(object self)
  765. { 
  766.     return Dup(self, 0, 1, 0); 
  767. } 
  768.  
  769. imeth objrtn Array_im_gDeepCopy(object self)
  770. { 
  771.     return Dup(self, 0, 1, 1); 
  772. } 
  773.  
  774. cmeth objrtn Array_cm_gIndexOrigin(object self, int n)
  775. { 
  776.     Index_origin = n; 
  777.     return self; 
  778. } 
  779.  
  780. #line 781 "array.c"
  781.  
  782. objrtn    Array_initialize(void)
  783. {
  784.     static  CRITICALSECTION  cs;
  785.     static  int volatile once = 0;
  786.  
  787.     ENTERCRITICALSECTION(_CI_CS_);
  788.     if (!once) {
  789.         INITIALIZECRITICALSECTION(cs);
  790.         once = 1;
  791.     }
  792.     LEAVECRITICALSECTION(_CI_CS_);
  793.  
  794.     ENTERCRITICALSECTION(cs);
  795.  
  796.     if (Array_c) {
  797.         LEAVECRITICALSECTION(cs);
  798.         return Array_c;
  799.     }
  800.     INHIBIT_THREADER;
  801.     Array_c = gNewClass(Class, "Array", sizeof(Array_iv_t), 0, END);
  802.     cMethodFor(Array, gIndexOrigin, Array_cm_gIndexOrigin);
  803.     cMethodFor(Array, gNew, Array_cm_gNew);
  804.     cMethodFor(Array, gIota, Array_cm_gIota);
  805.     cMethodFor(Array, gNewArray, Array_cm_gNewArray);
  806.     ivMethodFor(Array, vReshape, Array_ivm_vReshape, Array_ifm_vReshape);
  807.     iMethodFor(Array, gArrayPointer, Array_im_gArrayPointer);
  808.     iMethodFor(Array, gShape, Array_im_gShape);
  809.     iMethodFor(Array, gSize, Array_im_gSize);
  810.     iMethodFor(Array, gDispose, Array_im_gDispose);
  811.     iMethodFor(Array, gEqual, Array_im_gEqual);
  812.     ivMethodFor(Array, vChangeBitValue, Array_ivm_vChangeBitValue, Array_ifm_vChangeBitValue);
  813.     iMethodFor(Array, gGCDispose, Array_im_gDispose);
  814.     ivMethodFor(Array, vBitValue, Array_ivm_vBitValue, Array_ifm_vBitValue);
  815.     iMethodFor(Array, gRank, Array_im_gRank);
  816.     iMethodFor(Array, gStringRepValue, Array_im_gStringRepValue);
  817.     iMethodFor(Array, gCopy, Array_im_gCopy);
  818.     iMethodFor(Array, gDeepDispose, Array_im_gDeepDispose);
  819.     iMethodFor(Array, gIndex, Array_im_gIndex);
  820.     iMethodFor(Array, gStringRep, Array_im_gStringRep);
  821.     iMethodFor(Array, gDeepCopy, Array_im_gDeepCopy);
  822.  
  823.     ENABLE_THREADER;
  824.  
  825.     LEAVECRITICALSECTION(cs);
  826.  
  827.     return Array_c;
  828. }
  829.  
  830.  
  831.  
  832.